(DEFPROP PRINT CPRINT EXPR)
(DEFPROP PRIN1 !$CPRIN1 EXPR)
(STOP)

(PROG (IBASE C ↑W)
      (SETQ IBASE 10)
      (ERRSET (REMGRIND) NIL)
      (SETQ C (LIST NIL))
      (PRINC (QUOTE LOADING/ GRIND/ 9))
 X    (COND ((EQ C (SETQ G (READ C))) (RETURN (QUOTE *))) (T (EVAL G) (GO X))))

(AND (NOT (GET (QUOTE *REARRAY) (QUOTE LSUBR)))
     (GET (QUOTE RE*ARRAY) (QUOTE FSUBR))
     (DEFUN *REARRAY FEXPR (L) (APPLY (QUOTE RE*ARRAY)
				      (CONS (EVAL (CAR L)) (CDR L))))
     (DEFUN *ARRAY FEXPR (L) (APPLY (QUOTE ARRAY)
				    (CONS (EVAL (CAR L)) (CDR L)))))

(DEFUN REMGRIND FEXPR (L) (PROG NIL
				(MAPC (QUOTE (LAMBDA (X)
						     (REMPROP X (QUOTE EXPR))))
				      (QUOTE (TURPRI SPRINT MAXPAN PANMAX)))
				(MAPC (QUOTE (LAMBDA (X)
						     (REMPROP X (QUOTE FEXPR))))
				      (QUOTE (GRINDEF GRIND1 GRIND0 REMGRIND)))
				(ERRSET (*REARRAY (QUOTE /	)) NIL)
				(ERRSET (*REARRAY (QUOTE / )) NIL)
				(SSTATUS GCTWA)))
(DEFUN SPEW (X) (TERPRI) (SPRINT X LINEL 0))

(DEFUN GRINDEF
 FEXPR
 (L)
 ((LAMBDA (H)
   (MAPC
    (QUOTE
     (LAMBDA (C)
      (COND
       ((ATOM C)
	(MAPC
	 (QUOTE
	  (LAMBDA (F)
		  (COND ((SETQ L (GET C F))
			 (TURPRI)
			 (TURPRI)
			 (COND ((AND (NOT (ATOM L))
				     (MEMQ F (QUOTE (EXPR FEXPR MACRO))))
				(SPRINT (CONS (QUOTE DEFUN)
					      (CONS C
						    (COND ((EQ F (QUOTE EXPR))
							   (CDR L))
							  ((CONS F (CDR L))))))
					LINEL
					0))
			       ((SPRINT (LIST (QUOTE DEFPROP) C L F)
					LINEL
					0)))))))
	 H))
       ((SETQ H (APPEND C H))))))
    L))
  (QUOTE (EXPR FEXPR VALUE MACRO)))
 (ASCII 0))

(DEFUN TURPRI EXPR NIL (TERPRI) (SETQ GRINDLINCT
				      (REMAINDER (PLUS 73 GRINDLINCT) 74)))
(DEFUN SPRINT
 (L N M)
 (PROG (F G H)
       (AND (LESSP N CHRCT)
	    (PRINC (/	 (*DIF (LSH (*DIF LINEL N) -3)
			       (LSH (*DIF LINEL CHRCT) -3))))
	    (PRINC (/  (*DIF CHRCT N))))
       (AND (OR (LESSP (PLUS M -1 (FLATSIZE L)) CHRCT) (ATOM L))
	    (RETURN (PRIN1 L)))
       (SETQ F (EQ (CAR L) (QUOTE PROG)))
       (PRINC (QUOTE /())
       (ERRSET
	(AND (NOT (ATOM (CDR L)))
	     (OR F (SETQ N (MAXPAN (CDR L)
				   (DIFFERENCE CHRCT (FLATSIZE (CAR L)) 1))))
	     (OR (ATOM (CAR L)) (NOT (LESSP (MAXPAN (CDR L) CHRCT) N)))
	     (PROG NIL
		   (ERRSET (SETQ G
				 (LESSP (MAXPAN (LAST L)
						(*DIF (PLUS (FLATSIZE (LAST L))
							    CHRCT)
						      (FLATSIZE L)))
					N)))
	      A	   (PRIN1 (CAR L))
		   (PRINC (QUOTE / ))
		   (AND (CDR (SETQ L (CDR L))) G (GO A)))))
       (SETQ N CHRCT)
       (SETQ H (MEMQ (CAR L) (QUOTE (DEFPROP DEFUN LAMBDA LABEL))))
  B    (SPRINT (CAR L)
	       (COND ((SETQ G (AND F (CAR L) (ATOM (CAR L)))) (PLUS N 5)) (N))
	       (COND ((NULL (SETQ L (CDR L))) (ADD1 M))
		     ((ATOM L) (PLUS 4 M (FLATSIZE L)))
		     (0)))
       (COND ((ATOM L) (AND L (PRINC (QUOTE / /./ )) (PRIN1 L))
		       (RETURN (PRINC (QUOTE /))))))
       (COND (H (SETQ H NIL) (PRINC (QUOTE / )))
	     ((OR (LESSP CHRCT N) (AND G (ATOM (CAR L)))) (TURPRI)))
       (GO B)))

(DEFUN MAXPAN
       (L N)
       (PROG (G)
	     (SETQ G 0)
	A    (SETQ G (PLUS G (PANMAX (CAR L)
				     N
				     (COND ((NULL (SETQ L (CDR L))) (ADD1 M))
					   ((ATOM L) (PLUS M 4 (FLATSIZE L)))
					   (0)))))
	     (AND (ATOM L) (RETURN G))
	     (GO A)))
(DEFUN PANMAX (L N M) (COND ((LESSP (PLUS M -1 (FLATSIZE L)) N) 1)
			    ((OR (LESSP N 3) (ATOM L)) (ERR (QUOTE (50))))
			    ((AND (NOT (ATOM (CDR L)))
				  (ATOM (CAR L))
				  (SETQ N (DIFFERENCE N 1 (FLATSIZE (CAR L))))
				  (SETQ L (CDR L))
				  NIL))
			    ((MAXPAN L (SUB1 N)))))

(DEFUN GRIND0
 FEXPR
 (L)
 (PROG (G ↑Q ↑R ↑W)
       (APPLY (QUOTE UREAD) L)
       (UWRITE)
       (SETQ ↑Q (SETQ ↑R (SETQ ↑W (SETQ GRINDLINCT 73))))
  A    (COND
	((LESSP
	  (TURPRI)
	  (CAR (ERRSET (REMAINDER (PANMAX (COND ((EQ (SETQ G (READ L)) L)
						 (RETURN (CONS (QUOTE UFILE)
							       L)))
						(G))
					  CHRCT
					  0)
				  74))))
	 (SETQ GRINDLINCT 73)
	 (TYO 14)
	 (SETQ CHRCT LINEL))
	((TURPRI)))
       (SPRINT G CHRCT 0)
       (GO A)))

(DEFUN GRIND1 FEXPR (L) ((LAMBDA (LINEL) (APPLY (QUOTE GRIND0) L)) 120))

(SETQ GRINDLINCT 10)

((LAMBDA (G F H) (APPLY G (QUOTE (/	 20))) (APPLY G (QUOTE (/  10))))
 (QUOTE (LAMBDA (M N) (*ARRAY M T N) (H)))
 (QUOTE (LAMBDA (N) (COND ((NOT (LESSP N 0))
			   (APPEND (GET M (QUOTE PNAME))
				   (CADDR (STORE (APPLY M (LIST N))
						 (LIST (CAR NIL)
						       (QUOTE PNAME)
						       (H)))))))))
 (QUOTE (LAMBDA NIL (APPLY F (LIST (SUB1 N))))))
(RUN)
β